home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / Ant Movie Catalog 3.5.0.2 / amc_install.exe / {app} / Scripts / Alapage (Large Pic).ifs < prev    next >
Text File  |  2005-03-13  |  10KB  |  298 lines
  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=Thierry Colier
  8. Title=Alapage
  9. Description=Alapage (FR) Descriptif et image
  10. Site=http://www.alapage.com
  11. Language=FR
  12. Version=
  13. Requires=3.5.0
  14. Comments=
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19.  
  20. ***************************************************)
  21.  
  22. program ALAPAGE_FR;
  23. var
  24.   MovieName: string;
  25.  
  26. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  27. var
  28.   i: Integer;
  29. begin
  30.   result := -1;
  31.   if StartAt < 0 then
  32.     StartAt := 0;
  33.   for i := StartAt to List.Count-1 do
  34.     if Pos(Pattern, List.GetString(i)) <> 0 then
  35.     begin
  36.       result := i;
  37.       Break;
  38.     end;
  39. end;
  40.  
  41. procedure AnalyzeMoviePage(Page: TStringList);
  42. var
  43.   Line, Value, value2, nomImg: string;
  44.   LineNr: Integer;
  45.   BeginPos, EndPos, BeginVal2: Integer;
  46.   OnContinue : Boolean;
  47. begin
  48.    // Titre
  49.    LineNr := FindLine('<TD width="100%" class="tx14dvdbold">', Page, 0);
  50.    if LineNr > -1 then
  51.    begin
  52.       Value := Page.GetString(LineNr + 1);
  53.       value := trim(StringReplace (Value, #9, #32)); // pour remplacer les tabulations du debut par des espaces
  54.       HTMLRemoveTags(Value);
  55.       Value := AnsiUpFirstLetter(AnsiLowerCase(Value));
  56.       SetField(fieldTranslatedTitle, Value);
  57.    end;
  58.     
  59.    // Acteurs
  60.    LineNr := FindLine('<B>avec : </B>"<U><A', Page, 0);
  61.    if LineNr > -1 then
  62.    begin
  63.       Line := Page.GetString(LineNr);
  64.       Value := '';    
  65.       repeat
  66.          BeginPos := pos('X_LF_1" class="roll">', Line);
  67.          if (BeginPos > 0) then
  68.          begin
  69.             Delete(Line, 1, BeginPos+20);
  70.             EndPos := pos('</A></U>"', Line);
  71.             Value := Value + Copy(Line, 1, EndPos-1) + ' - ';
  72.          end;
  73.       until ( BeginPos = 0);
  74.       SetField(fieldActors, Value);
  75.    end;
  76.     
  77.    // Image
  78.    LineNr := FindLine('href="javascript:{agrandir(', Page, 0);
  79.    if LineNr > -1 then
  80.    begin
  81.       Line := Page.GetString(LineNr);
  82.       BeginVal2 := pos ('agrandir(', Line);
  83.       Delete(Line, 1, BeginVal2+9);
  84.       BeginVal2 := pos (',', Line);
  85.       value2 := copy (Line, 1, BeginVal2-2);
  86.       Line := Page.GetString(LineNr+1);
  87.  
  88.       BeginPos := pos('src="', Line) + 4;
  89.       Delete(Line, 1, BeginPos);
  90.       EndPos := pos('ref=v', Line);
  91.       Value := copy(Line, 1, EndPos + 4);
  92.       nomImg := 'http://www.alapage.com'+Value+Value2+'r.jpg';
  93. //      nomImgVerso := 'http://www.alapage.com'+Value+Value2+'v.jpg';
  94.       GetPicture(nomImg); // False = stocke l'image dans la base
  95.    end;
  96.  
  97.    // RΘalisateur
  98.    LineNr := FindLine('">Réalisateur :  </TD>', Page, 0);
  99.    if LineNr > -1 then
  100.    begin
  101.       Line := Page.GetString(LineNr+1);
  102.       BeginPos := pos('"roll"><SPAN class="tx12noir">', Line);
  103.       EndPos := pos('</SPAN></A>', Line);
  104.       Value := Copy(Line, BeginPos+30, EndPos - BeginPos-30);
  105.       SetField(fieldDirector, Value);
  106.    end;
  107.  
  108.    // Genre
  109.    LineNr := FindLine('">Genre :  </TD>', Page, 0);
  110.    if LineNr > -1 then
  111.    begin
  112.       Line := Page.GetString(LineNr+1);
  113.       BeginPos := pos('"roll"><SPAN class="tx12noir">', Line);
  114.       EndPos := pos('</SPAN></A>', Line);
  115.       Value := Copy(Line, BeginPos+30, EndPos - BeginPos-30);
  116.       SetField(fieldCategory, Value);
  117.    end;
  118.  
  119.    // Editeur
  120.    LineNr := FindLine('">Editeur :  </TD>', Page, 0);
  121.    if LineNr > -1 then
  122.    begin
  123.       Line := Page.GetString(LineNr+1);
  124.       BeginPos := pos('<SPAN class="tx12noir">', Line);
  125.       EndPos := pos('</SPAN></TD>', Line);
  126.       Value := Copy(Line, BeginPos+23, EndPos - BeginPos-23);
  127.       SetField(fieldProducer, Value);
  128.    end;
  129.  
  130.    // Zone
  131.    LineNr := FindLine('">Zone :  </TD>', Page, 0);
  132.    if LineNr > -1 then
  133.    begin
  134.       Line := Page.GetString(LineNr+1);
  135.       BeginPos := pos('<SPAN class="tx12noir">', Line);
  136.       EndPos := pos('</SPAN></TD>', Line);
  137.       Value := Copy(Line, BeginPos+23, EndPos - BeginPos-23);
  138.       SetField(fieldVideoFormat, 'DVD Zone '+Value);
  139.    end;
  140.  
  141.    // Description
  142.    LineNr := FindLine('class="tx14grisbold">Commentaires</TD>', Page, 0);
  143.    if LineNr > -1 then
  144.    begin
  145.       Value := StringReplace(Page.GetString(LineNr+12), '<br>', #13#10); ;
  146.       HTMLRemoveTags(Value);
  147.       HTMLDecode(Value);
  148.       value := StringReplace (Value, #9, #32); // pour remplacer les tabulations du debut par des espaces
  149.       SetField(fieldDescription, Trim(Value));
  150.    end;
  151.  
  152.    // Bonus
  153.    LineNr := FindLine('">Bonus / Interactivité</TD>', Page, 0);
  154.    if LineNr > -1 then
  155.    begin
  156.       Value := 'Bonus / InteractivitΘ :'+#13#10;
  157.       repeat
  158.            OnContinue := False;
  159.          repeat
  160.             LineNr := LineNr + 1;
  161.             Line := Page.GetString(LineNr);
  162.             BeginPos := pos('/puce_grise.gif" border="0" alt="">', Line);
  163.          until ( (BeginPos > 0) or (pos('<a name="donneravis">', Line)>0) );
  164.          if (BeginPos > 0) then
  165.          begin
  166.             OnContinue := True;
  167.             LineNr := LineNr + 1;
  168.             Line := Page.GetString(LineNr);
  169.             BeginPos := pos('"tx12noir" colspan="2">', Line);
  170.             EndPos := pos('<BR></TD>', Line);
  171.             Value := Value + Copy(Line, BeginPos+23, EndPos - BeginPos-23) + #13#10;
  172.          end;
  173.       until ( OnContinue = False);
  174.       HTMLRemoveTags(Value);
  175.       HTMLDecode(Value);
  176.       SetField(fieldComments, Value);
  177.    end;
  178.  
  179.    //DisplayResults;
  180. end;
  181.  
  182. procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
  183. var
  184.   Line: string;
  185.   MovieTitle, MovieAddress: string;
  186.   StartPos: Integer;
  187.   EndPos: Integer;
  188.   LastLine: Integer;
  189.  
  190. begin
  191.   repeat
  192.     LineNr := LineNr + 1;
  193.     Line := Page.GetString(LineNr);
  194.     LastLine := Page.count;
  195.     StartPos := pos('&VID_NUMERO=', Line);
  196.     if ((Startpos>0) and (pos('> Disponible en <b>occasion</b>', Line) > 0 )) then StartPos := 0; // pour ne pas prendre les lignes d'occasions
  197.     if StartPos > 0 then 
  198.     begin
  199.          LineNr := LineNr + 3;
  200.          Line := Page.GetString(LineNr);
  201.          StartPos := pos('href="/mx/?id=', Line);
  202.          Delete(Line, 1, StartPos);
  203.          MovieAddress := copy(Line, 6, pos('class="tx12noirbold"><u>', Line)-8 );
  204.          Delete(Line, 1, pos('><u>', Line)+3);
  205.          EndPos := pos('</u></A>', Line);
  206.          MovieTitle := copy(Line, 1, EndPos-1);
  207.          HTMLDecode(Movietitle);
  208.          PickTreeAdd(MovieTitle, 'http://www.alapage.com' + MovieAddress);
  209.     end;
  210.   until ((pos('Recherche rapide ', Line) > 0) or (pos('Page suivante »</DIV>', Line) > 0) or (pos('« Page précédente</a>', Line) > 0)) ;
  211.   if (pos('« Page précédente</a>', Line) > 0) then
  212.   begin
  213.      StartPos := pos('<a href="', Line);
  214.      EndPos :=     pos('" class="roll">« Page', Line);
  215.      PickTreeAdd('... << RΘsultats prΘcΘdents', 'http://www.alapage.com' + copy (Line, StartPos+9, Endpos-StartPos-9));
  216.   end;
  217.   if (pos('Page suivante »</DIV>', Line) > 0) then
  218.   begin
  219.      StartPos := pos('|  <A href="', Line);
  220.      EndPos :=     pos('" class="roll">Page suivante ', Line);
  221.      PickTreeAdd('RΘsultats suivants >> ...', 'http://www.alapage.com' + copy (Line, StartPos+22, Endpos-StartPos-22));
  222.   end;
  223. end;
  224.  
  225. procedure AnalyzePage(Address: string);
  226. var
  227.   Page: TStringList;
  228.   LineNr: Integer;
  229.   Line : String;
  230.   StartPos, EndPos : integer;
  231.   Adr : String;
  232. begin
  233.   Page := TStringList.Create;
  234.   Page.Text := GetPage(Address);
  235.  
  236.   if pos('> Caractéristiques</TD>', Page.Text) > 0 then 
  237.   begin
  238.     SetField(fieldURL, Address);
  239.     AnalyzeMoviePage(Page)
  240.   end
  241.   else
  242.      begin
  243.      if pos('>1 réponse</SPAN> pour', Page.Text) > 0 then // 1 rΘponse, on ouvre directement la page
  244.      begin
  245.        LineNr := 0;
  246.        LineNr := FindLine('&VID_NUMERO=', Page, LineNr);
  247.        Line := Page.GetString(LineNr+3);
  248.        StartPos := pos('href="/mx/?id=', Line);
  249.        Delete(Line, 1, StartPos);
  250.        Adr := 'http://www.alapage.com' + copy(Line, 6, pos('class="tx12noirbold"><u>', Line)-8 );
  251.        SetField(fieldURL, Adr);
  252.        Page.Text := GetPage(Adr);
  253.        AnalyzeMoviePage(Page)
  254.      end 
  255.      else 
  256.      begin
  257.          if pos('pas trouvé de réponses', Page.Text) > 0 then // aucune rΘponse
  258.          begin
  259.               ShowMessage('Aucun Film TrouvΘ pour : ' + MovieName);
  260.          end 
  261.          else
  262.          begin
  263.               PickTreeClear;
  264.               LineNr := 0;
  265.               LineNr := FindLine('réponses</SPAN> pour "', Page, LineNr); // trouvΘ plusieurs rΘponse
  266.               if LineNr > -1 then
  267.               begin
  268.                    Line := Page.GetString(LineNr);
  269.                    StartPos := pos ('<SPAN class="tx14orangefoncebold">', Line);
  270.                    EndPos := pos('réponses</SPAN>', Line);
  271.                    PickTreeAdd(copy (Line, StartPos+34, EndPos-StartPos-35)+' Films TrouvΘs pour ' + MovieName + ' :', '');
  272.                    AddMoviesTitles(Page, LineNr);
  273.               end;
  274.               if PickTreeExec(Address) then
  275.                  AnalyzePage(Address);
  276.          end;
  277.      end;
  278.   end;
  279.   Page.Free;
  280.  
  281. end;
  282.  
  283. begin
  284.   if CheckVersion(3,5,0) then
  285.   begin
  286.     MovieName := GetField(fieldTranslatedTitle);
  287.     if MovieName = '' then
  288.       MovieName := GetField(fieldOriginalTitle);
  289.  
  290.     if Input('Alapage.com Import', 'Entrer le titre du film :', MovieName) then
  291.     begin
  292.        AnalyzePage('http://www.alapage.com/mx/?tp=L&type=4&id=75071065095581&donnee_appel=BIGBO&suv_type=1&dispo=0&sort=titre&mot_vid_titre='+UrlEncode(MovieName));
  293.     end;
  294.   end 
  295.   else
  296.       ShowMessage('Ce script requiert une version plus rΘcente de Ant Movie Catalog (au moins la version 3.5.0)');
  297. end.
  298.